comment TENEX code for TEX I/O;

comment This page contains the most operating-system dependent aspects
of the TEX input system;

saf string array fname[0:2] # file directory, name, and extension;
simple procedure scanfilename # sets up fname[0:2];
begin integer j;
fname[0]←fname[1]←fname[2]←null;
j←1;
while true do
	begin getnctok;
	if curcmd = spacer then done;
	if curcmd≥charcodes then
		begin backerror("Blank space should follow file name"); done;
		end;
	if curchar = "<" then j←0
	else if curchar = "." then j←2;
	fname[j]←fname[j]&curchar;
	if curchar = ">" then j←1;
	end;
end;

internal procedure inputfile;
begin comment "\input" has just been scanned. This procedure scans
the user's file name, employing the TENEX naming conventions, then reads
in the first line and feeds it to the input system;
integer chan;
label abort # if something goes wrong trying to read the file;
label retry # go here to try again;
boolean firsttry # first attempt to read the file;
string flname;
define checkeof=⊂if eof then begin print(")");go to abort end⊃;
firsttry←true; retry:
scanfilename;
if fname[2]=0 then fname[2]←".TEX" # default extension;
flname←fname[0]&fname[1]&fname[2];

open(chan←getchan,"DSK",0, 1,0, 4000,brchar,eof) # input, no output;
lookup(chan,flname,eof);
comment if lookup failed and no explicit directory was given, try <TEX>;
if eof and fname[0]=0 then
	begin comment if lookup failed and no explicit directory was given,
		try default directory <TEX>;
	flname←"<TEX>"&flname;
	lookup(chan,flname,eof);
	end;
if eof then
	begin error("Lookup failed on file "&flname);
	if firsttry then
		begin firsttry←false; release(chan); go to retry;
		end;
	go to abort;
	end;
print(" (",flname);
pushinput # save present file status;
state←newline; recovery←chan; filename←flname;
inbuf←input(chan,crffbreak) # get first line of file;
checkeof; print(" 1");
if equ(inbuf[1 to 9],"COMMENT ⊗") then
	begin comment Skip TVedit directory page;
	while brchar≠'14 and not eof do inbuf←input(chan,ffbreak);
	checkeof;
	inbuf←input(chan,crffbreak) # get first line of second page;
	checkeof; print(" 2");
	loc ← (2 lsh infod) + 1 # page 2 line 1;
	end
else	loc ← (1 lsh infod) + 1 # page 1 line 1;
if tracing land '20 then
	begin integer p; string s # garbage bin;
	if inbuf='12 then p←lop(inbuf);
	if length(inbuf)=1 then inbuf←" "&inbuf;
	print(nextline);
	outstr(inbuf[1 to ∞-1]) # show inbuf on screen;
	s←inchwl;
	if s≠0 then inbuf←s&inbuf[∞ to ∞];
	end;
curbuf←inbuf;

comment Now define the output file name if it hasn't yet been defined;
if ofilname=0 then declareofil(fname[1]&ofilext) # no explicit directory here;
return;

abort: release(chan);
popinput;
end;

internal integer procedure opendigit(integer d) # Do this after "\open d =";
begin integer chan; string s;
scanfilename;
if fname[2]=0 then fname[2]←".TEX" # default extension;
s←fname[0]&fname[1]&fname[2];
open(chan←getchan,"DSK",0,0,2,0,0,eof);
loop    begin enter(chan,s,eof);
        if eof then
                begin print(nextline,"I can't write on file ",s,
                        nextline,"Output file for \open "&d&" = ");
                s←inchwl;
                end
        else done
        end;
return(chan);
end;

internal procedure definefont(integer f) # Do this after seeing "=" of font def;
begin integer n,p,chan; string s;
label try,retry # go here to try again;
boolean firsttry # first attempt to read the file;
firsttry←true; go to try;
retry: if firsttry then firsttry←false else quit;
try: scanfilename;
if fname[0]=0 then fname[0]←libraryarea;
s←fname[1] # without directory or extension;
if fontname[f] and not equ(s,fontname[f]) then
	begin error("Sorry, this font code is already defined to be "&fontname[f]);
	return;
	end;
fontname[f]←s;

if parbase[f]=0 then
	begin comment font information not preloaded;
	open(chan←getchan,"DSK",8,2,0,0,0,eof);
	lookup(chan,s←fname[0]&fname[1]&deviceext,eof);
	if eof then
		begin error("Lookup failed on file "&s);
		release(chan); go to retry;
		end;
	readfontinfo(chan,f) # input font info for use by TEXSEM and TEXOUT;
	release(chan);
	end;
p←fontglue+f*gluespecsize # location of "font glue";
mem[p]←1000000 lsh infod # "infinite" reference count;
gluespace(p)←fontpar(f,spacewd);
gluestretch(p)←fontpar(f,spacestr);
glueshrink(p)←fontpar(f,spaceshr);
if fontpar(f,device2) neq rfudge then error("Warning: font has wrong rfudge");
end;